(*
Universidade de Brasilia
Departamento de Ciencia da Computacao
Programacao Funcional - turma A

Nome:Igor Rafael de Sousa Matrícula: 06/86247
Nome:Anderson Campos Cardoso Matrícula: 05/77065
*)

(*
  Jogo Point and Click:
  "Um tipo de jogo de computador que se enquadra no gênero aventura
   onde a posição do observador (jogador) é a do próprio personagem
   e cujo objetivo seja a exploração de um determinado cenário onde
   vão sendo apresentados desafios que o jogador deve resolver"
  Fonte: http://pt.wikipedia.org/wiki/Aventura_em_primeira_pessoa
  
  Historia do Jogo:
  Voce esta trancado no Laboratorio de Hardware do Linf com uma FPGA
  programada para explodir em um minuto, seu objetivo e escapar do
  laboratorio ou desarmar a FPGA.

  Comandos:
  Utilize o mouse para selecionar os objetos na tela, o botao esquerdo
  checa o objeto selecionado e o botao direito adiciona o objeto selecionado
  a sua lista de itens ou usa um item de seu iventario no objeto selecionado.
   
  Itens:
  Existem dois itens no jogo, uma chave que pode ser utilizada na porta
  trancada e um estabilizador que pode ser utilizado no computador para
  liga-lo.

  Bibliotecas utilizadas(http://ocamlsdl.sourceforge.net/home.html):
  libsdl-ocaml
  libsdl-image1.2
  libsdl-ttf1.2
  libsdl-mixer1.2
  
  Para compilar execute na raiz
  $make
  
  
  Para rodar execute na raiz
  ./fpnc
  
  Para versão com os arquivos de imagens:
  (grandes demais para serem enviados pelo moodle)
  http://code.google.com/p/fpnc/source/checkout
*)

(* Opening most used libraries, for legibility *)
open Sdlevent
open Sdlkey
open Sdlvideo 


(**********************************************************************************************)

(* DEFINITIONS *)

(* Until image resizing is implemented, width and height must be the same of ALL images *) 
let screen_width = 640
let screen_height = 400

let font_name = "font.ttf"
let font_size = 28
let font_size_small = 22

let background_color = white
let text_color:Sdlvideo.color = (0,31,127)

let textbg = "images/textbg.png"
let first_music = "main.ogg"
let lose_music = "lose.mp3"
let win_music1 = "victory.ogg"
let win_music2 = "victory2.ogg"

(* tempo *)
let limit = 60 (*limit in seconds*)
let red_limit = 5 (*limit, in seconds, to change the color to red*)  

let senha = "swordfish"
let dica_de_senha = "No LCD da FPGA le-se \"A senha\"."

(**********************************************************************************************)

(* STATE *)

(* Possible item types *)
type item = Key | Stabilizer

type obj = {
    mask:surface;
    id:int;
}

type state = {
    name      : string;
    text      : string;
    time      : int;
    itens     : item list;
    objects   : obj list;
    scenario  : Sdlvideo.surface;
    font      : Sdlttf.font;
    font_small: Sdlttf.font;
    textbg    : Sdlvideo.surface;
}


let set_text txt stt = {
    name=stt.name;
    text=txt;
    time=stt.time;
    itens=stt.itens;
    objects=stt.objects;
    scenario=stt.scenario;
    font=stt.font;
    font_small=stt.font_small;
    textbg=stt.textbg;
}


let set_name str stt = {
    name=str;
    text=stt.text;
    time=stt.time;
    itens=stt.itens;
    objects=stt.objects;
    scenario=stt.scenario;
    font=stt.font;
    font_small=stt.font_small;
    textbg=stt.textbg;
}


let set_scenario txt objs scen mus stt = {
    name=stt.name;
    text=txt;
    time=stt.time;
    itens=stt.itens;
    objects=objs;
    scenario=scen;
    font=stt.font;
    font_small=stt.font_small;
    textbg=stt.textbg;
}

let add_obj obj stt =
	if (List.mem obj stt.objects)
		then stt
		else{
			name=stt.name;
			text=stt.text;
			time=stt.time;
			itens=stt.itens;
			objects=obj::stt.objects;
			scenario=stt.scenario;
			font=stt.font;
			font_small=stt.font_small;
    		textbg=stt.textbg;
		}
	
let add_item item stt =
	if (List.mem item stt.itens)
		then stt
		else{
			name=stt.name;
			text=stt.text;
			time=stt.time;
			itens=item::stt.itens;
			objects=stt.objects;
			scenario=stt.scenario;
			font=stt.font;
			font_small=stt.font_small;
    		textbg=stt.textbg;
		}
	
let remove_item item stt =
    let rec remover elemento l = match l with
    | [] -> []
    | h::t -> if (elemento != h) then
                 h::(remover elemento t)
              else
                 remover elemento t in
	{
		name=stt.name;
		text=stt.text;
		time=stt.time;
		itens=(remover item stt.itens);
		objects=stt.objects;
		scenario=stt.scenario;
		font=stt.font;
		font_small=stt.font_small;
    	textbg=stt.textbg;
	}


let set_time time stt = {
    name=stt.name;
    text=stt.text;
    time=time;
    itens=stt.itens;
    objects=stt.objects;
    scenario=stt.scenario;
    font=stt.font;
    font_small=stt.font_small;
    textbg=stt.textbg;
}


(**********************************************************************************************)

(* SCREEN *)

(* Attemps to get current video surface and creates one if it fails *)
(* "Singleton" only possible due to SDL bindings *)
let screen = try Sdlvideo.get_video_surface () with 
             _ -> Sdlvideo.set_video_mode screen_width screen_height [`DOUBLEBUF;`HWSURFACE]

(* Draws an string on the center of the screen *)
let blit_string s font bg =
    match s with
    | "" -> ()
    | _ ->(
    let text = Sdlttf.render_text_blended font s ~fg:(0,31,127) in 
    match Sdlvideo.surface_dims text with
        | w,h,_ ->
        	Sdlvideo.blit_surface ~src:bg
        	                      ~src_rect:{r_x=0; r_y=0; r_w=w; r_h=h}
        	                      ~dst:screen
        	                      ~dst_rect:{r_x=(screen_width/2-w/2); r_y=(screen_height-h-50); r_w=w; r_h=h} ();
        	Sdlvideo.blit_surface ~src:text ~dst:screen ~dst_rect:(Sdlvideo.rect (screen_width/2-w/2) (screen_height-h-50) w h) ()
    )

(* Draws an string in the defined position, but with unlimited width and height *)
let blit_string_pos x y s font cor bg=
    let s = match s with
        | "" -> " " (* render_text functions don't like empty strings *)
        | _  -> s in
    let text = Sdlttf.render_text_blended font s ~fg:cor in 
    match Sdlvideo.surface_dims text with
        | w,h,_ -> 
        	Sdlvideo.blit_surface ~src:bg
        	                      ~src_rect:(Sdlvideo.rect 0 0 w h)
        	                      ~dst:screen
        	                      ~dst_rect:(Sdlvideo.rect x y w h) ();
        	Sdlvideo.blit_surface ~src:text ~dst:screen ~dst_rect:(Sdlvideo.rect x y w h) ()

(* Draws an string in the defined position, limiting width and height *)
let blit_string_rect rect s font cor =
    let s = match s with
        | "" -> " " (* render_text functions don't like empty strings *)
        | _  -> s in
    let text = Sdlttf.render_text_blended font s ~fg:cor in 
    match Sdlvideo.surface_dims text with
        | w,h,_ -> Sdlvideo.blit_surface ~src:text ~src_rect:{r_x=0;r_y=0;r_w=rect.r_w;r_h=rect.r_h}
                                         ~dst:screen ~dst_rect:rect ()

(* Draws an image as backround *)
let draw_image img = Sdlvideo.blit_surface ~src:img ~dst:screen ()

(* Recursively draws itens starting at position (x,y) *)
let rec draw_items itens x y =
	match itens with
	| [] -> ()
	| Key::tail ->
		let img = Sdlloader.load_image "images/keyicon.png" in
		Sdlvideo.blit_surface ~src:img ~dst:screen
		                      ~dst_rect:{r_x=x;
		                                 r_y=y;
		                                 r_w=(surface_info img).w;
		                                 r_h=(surface_info img).h} ();
		draw_items tail (x+(surface_info img).w) y
	| Stabilizer::tail ->
		let img = Sdlloader.load_image "images/stabilizericon.png" in
		let info = (surface_info img) in
		Sdlvideo.blit_surface ~src:img
		                      ~src_rect:{r_x=0;r_y=0;r_w=info.w;r_h=info.h}
							  ~dst:screen
		                      ~dst_rect:{r_x=x;r_y=y;r_w=info.w;r_h=info.h} ();
		draw_items tail (x+(surface_info img).w) y
		
(**********************************************************************************************)
(*SOUND*)

(* Halts currently playing music (if any)
   SDL has at most one music at any given time *)
let play_music music_name = 
        Sdlmixer.halt_music ();
	    Sdlmixer.play_music (Sdlmixer.load_music music_name)
		
(**********************************************************************************************)
(*TIME*)
(* Calculates time left and prints onscreen *)
let update_time state = 
    let time = limit - ((Sdltimer.get_ticks () - state.time)/1000) in
    let cor = if (time <= red_limit) then
                 Sdlvideo.red
              else
                 Sdlvideo.white in  
    if (time > 0) then(
        blit_string_pos (screen_width - 100) 3 ("Tempo: " ^ string_of_int time) state.font_small cor state.textbg;
        false)
    else
        true

(**********************************************************************************************)

(*LOOP FOR END GAME*)

(* Shows one last state and raises an exception to exit from game when a key is pressed *)
exception Sair
let rec finish state = 
    Sdlvideo.flip screen;
    Sdlvideo.fill_rect screen (Sdlvideo.map_RGB screen background_color);
    draw_image state.scenario;
    blit_string state.text state.font state.textbg;
    match poll () with
    | None ->  finish state
    | Some x ->
    match x with
    | KEYDOWN l (*{keysym=KEY_ESCAPE} | KEYDOWN {keysym=KEY_q } | KEYDOWN {keysym=KEY_RETURN}*) ->
        raise Sair
    | event ->
        finish state


(*Read a typed string*)
let read_string state login =
    let rec read_more_of s =
        Sdlvideo.flip screen;
        Sdlvideo.fill_rect screen (Sdlvideo.map_RGB screen background_color);
        draw_image login;
        let fim = update_time state in
        if fim then state else(
        blit_string_rect {r_x=207; r_y=290; r_w=218; r_h=25} s state.font_small Sdlvideo.black;
		match poll () with
		| None -> read_more_of s
		| Some event ->
        match event , s with
        | KEYDOWN {keysym=KEY_ESCAPE}, _ ->
            state
        | KEYDOWN {keysym=KEY_RETURN}, s ->
            if (String.compare s senha)=0 then (
                play_music win_music1;
                finish (set_scenario "Parabens!!! Voce desarmou a FPGA" [] ((Sdlloader.load_image "images/vitoria.png")) "" state)
                )
            else (set_text "Chutando a senha, que coisa feia..." state)
        | KEYDOWN {keysym=KEY_BACKSPACE}, "" ->
            read_more_of ""
        | KEYDOWN {keysym=KEY_BACKSPACE}, s ->
            read_more_of (String.sub s 0 (String.length s - 1))
        | KEYDOWN {keycode='a'..'z'|'A'..'Z'|'0'..'9'|' ' as keycode}, s ->
            let string_of_key = String.make 1 keycode in
            if (String.length s) < 42 then
                read_more_of (s ^ string_of_key)
            else 
                read_more_of (s)
        | _, s ->
            read_more_of s
            )
    in
    read_more_of ""
 
(**********************************************************************************************)
(* OBJECTS *)

let object_names = ["images/mask-cpu.png"; "images/mask-fpga.png"; "images/mask-door.png"; "images/mask-cpu.png"; "images/mask-key.png"; "images/mask-estabil-cpu_des-caixa_aberta_com_chave.png"]

(* Object factory, creates sequential ids *)
let objects =
    let rec assemble names id =
            match names with
            |[] -> []
            |hd::tl -> {mask=(Sdlloader.load_image hd); id=id}::(assemble tl (id+1))
    in
    assemble object_names 0

exception Not_found
let rec get_id x y objects = 
    match objects with
    | [] -> raise Not_found
    | hd::tl ->
        match Sdlvideo.get_pixel_color hd.mask x y with
        | 255,0,255 -> get_id x y tl
        | _,_,_ -> hd.id



(**********************************************************************************************) 
(* OBJECT FUNCTIONS *)    

let use_key stt = 
	if (List.mem Key stt.itens) then (
        play_music win_music2;
        finish (set_scenario "Parabens!!! Voce saiu... E o lab hardware explodiu!" [] ((Sdlloader.load_image "images/perdeu.png")) "" stt)
        )
	else
	    stt
	    
let use_stabilizer stt = 
    let stt_removido = remove_item Stabilizer stt in
	if (List.mem Stabilizer stt.itens)
	then {
		name=stt.name;
		text=stt.text;
		time=stt.time;
		itens=stt_removido.itens;
		objects=(List.hd objects)::stt.objects;
		scenario=Sdlloader.load_image "images/cpu_lig-caixa_aberta_com_chave.png";
		font=stt.font;
		font_small=stt.font_small;
		textbg=stt.textbg;
	}
	else
	    stt

let take_key state =
    let state = (add_item Key state) in
    if (List.mem Key state.itens) then state
    else set_text "Voce pegou uma chave." state

let take_stabilizer state =
    let state = (add_item Stabilizer state) in
    if (List.mem Stabilizer state.itens) then state
    else set_text "Voce pegou um estabilizador." state

let same state = state
let take_key state = add_item Key state
let type_password state = read_string state (Sdlloader.load_image "images/login.png")

let left_functions = [set_text "O computador esta ligado.";
                      set_text dica_de_senha;
                      set_text "A porta esta trancada.";
                      set_text "O computador precisa de energia para funcionar.";
                      set_text "Um molho de chaves!!!";
                      set_text "Tem alguma coisa escondida neste canto...";]


let right_functions = [type_password;
                       same;
                       use_key;
                       use_stabilizer;
                       take_key;
                       take_stabilizer;]

let middle_functions = right_functions;

(**********************************************************************************************)
(* FUNCTIONS MAPPING*)

(*
  PORQUE USAR O MAP:
  O modulo map foi utilizado porque tivemos problemas em ter uma funcao
  "state -> state" dentro de um objeto state.
  
  Assim precisamos uma maneira de relacionar um objeto
  (pertencente ao estado) a uma funcao (de fora do estado).
  Isso foi feito registrando um ID para todos os objetos e mapando
  esses ID as funcoes.
*)
module FunMap = Map.Make (struct
                             type t = int
                             let compare = compare
                           end)

(* Creates a map relating functions to object's id *)
let rec map_functions objects functions = 
    match objects,functions with
    | [],_ -> FunMap.empty
    | _,[] -> FunMap.empty
    | hdObj::tlObj, hdFun::tlFun -> FunMap.add hdObj.id hdFun (map_functions tlObj tlFun)


(**********************************************************************************************)

(* MAIN LOOP *)

(* Each loops depends on the current state and a function map for each mouse button *)
let rec run state left_functions middle_functions right_functions =
    (*Loops the state with the function maps*)
	let loop state = run state left_functions middle_functions right_functions in

    (*Tries to get a function for the image in coordinates (x,y) if there's no object (and therefore no id) returns the identity*)
    let func_of_coord x y function_map = try FunMap.find (get_id x y state.objects) function_map
                            with Not_found -> (fun x -> x) in
    Sdlvideo.flip screen;
    Sdlvideo.fill_rect screen (Sdlvideo.map_RGB screen background_color);
    draw_image state.scenario;
    draw_items state.itens 0 0; (* Draw itens on top left corner *)
    if (update_time state) then 
    (  
        play_music lose_music;
        finish (set_scenario "O tempo acabou!!!" [] ((Sdlloader.load_image "images/perdeu.png")) "" state);
    );
    blit_string state.text state.font state.textbg;
    match poll () with
    | None -> loop state
    | Some event ->
    match event with
    | KEYDOWN {keysym=KEY_ESCAPE} | KEYDOWN {keysym=KEY_q} ->
        print_endline "Quitter! The fun is over now."
    | MOUSEBUTTONDOWN mouse ->
        ( (*Which mouse button was pressed*)
        match mouse with
            | {mbe_button=Sdlmouse.BUTTON_LEFT; mbe_state=PRESSED}
              -> loop (func_of_coord mouse.mbe_x mouse.mbe_y left_functions state)
            | {mbe_button=Sdlmouse.BUTTON_MIDDLE; mbe_state=PRESSED}
              -> loop (func_of_coord mouse.mbe_x mouse.mbe_y middle_functions state)
            | {mbe_button=Sdlmouse.BUTTON_RIGHT; mbe_state=PRESSED}
              -> loop (func_of_coord mouse.mbe_x mouse.mbe_y right_functions state)
        	| _
              -> loop state
        )
    | event ->
        loop state

let show_splash = 
    let rec wait_key s = match wait_event () with
                       | KEYDOWN _ -> print_endline s
                       | MOUSEBUTTONDOWN _ -> print_endline s
                       | event -> wait_key s
    in
    Sdlvideo.fill_rect screen (Sdlvideo.map_RGB screen background_color);
    draw_image (Sdlloader.load_image "images/splash.png");
    Sdlvideo.flip screen;
    wait_key "O jogo comecou comecou"
        
    

(* INITIALIZATION *)
let main () =
	Sdl.init [`VIDEO;`AUDIO ;`TIMER];
    at_exit Sdl.quit;
    (* Sdlvideo.set_video_mode occurs the first time the "screen" is requested *)
	Sdlttf.init ();
    at_exit Sdlttf.quit;
    Sdlkey.enable_unicode true;
    Sdlkey.enable_key_repeat ();
    Sdlmixer.open_audio ~freq:44100 ~format:Sdlmixer.AUDIO_FORMAT_S16SYS
                        ~chunksize:4096 ~channels:Sdlmixer.STEREO ();
    at_exit Sdlmixer.close_audio;
	play_music first_music;
    Sdlwm.set_caption ~title:"PF - 01/2009" ~icon:"imagens/icon.png";
    try run {
			  name="Main";
			  text="";
			  time=Sdltimer.get_ticks ();
			  itens=[];
			  objects=List.tl objects; (*the first object should not be in the state*)
			  scenario= (Sdlloader.load_image "images/estabil-cpu_des-caixa_aberta_com_chave.png");
			  font=Sdlttf.open_font font_name font_size;
			  font_small=Sdlttf.open_font font_name font_size_small;
    		  textbg=Sdlloader.load_image textbg;
            }
	    (map_functions objects left_functions)
	    (map_functions objects middle_functions)
	    (map_functions objects right_functions)
     with Sair -> ()



let _ = main ()

